home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
Source
/
DBL Pascal Library
/
AsyncSound
/
AsyncSound.p
Wrap
Text File
|
1993-02-09
|
12KB
|
422 lines
unit AsyncSound;
{February 9, 1992 — Detached resources made unpurgeable. Create channel with no synth.}
{ More error recovery. More documentation.}
{February 8, 1993 — Dispose sound channel if SndPlay gives an error.}
{November 28, 1992 — Call idle routine at start of inquiry routines.}
{August 7, 1992 — Don’t try to call nonexistent notify proc when manager is closed.}
{July 1992 — Corrected queueing of multiple calls; revised interface.}
{December 20, 1991 — Initial version.}
interface
const
AsyncSoundMaxChannels = 4;
{Init internal data for the specified number of channels. All channel modes set to initMono.}
{If the Macintosh system version is prior to 6.0.7, all other AsyncSound unit calls become}
{no–ops; this means you don’t have to test for sound manager presence at each call.}
function AsyncSoundInit (numberOfChannels: Integer): OSErr;
{Stop all sounds immediately. Call before _ExitToShell, if sounds might be active.}
{Notify procs for unfinished sounds will not be called. Also, if you call any AsyncSound unit}
{routines after the close, they’ll succeed without doing anything.}
procedure AsyncSoundClose;
{NOTE: All routines having a ‘whichChannel’ parameter return ‘paramErr’ on an invalid channel.}
{The following three routines play sampled sounds. The sound may be stored in a resource of}
{type 'snd ' and specified by name or ID, or may be passed in a handle. All sounds must be Type 1}
{sounds — sampled sounds must specify the sampled sound synth. A notify proc, if provided}
{is called with the specified message upon completion of the sound. If you don’t use a notify proc,}
{pass nil for the notifyProc parameter. If the new sound manager is not present at init time, or}
{if the AsyncSound unit is closed, the notifyProc will be called immediately. The completion}
{routine will never be called if the Play… function returns an error. The resource-based}
{routines detach the sound resource and make it unpurgeable before playing. The handle-based}
{routine depends upon the caller maintaining the state of the handle, perhaps using callbacks.}
function PlayAsyncNamedSoundResource (soundName: Str255; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
function PlayAsyncSoundResource (soundID: Integer; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
function PlayAsyncSoundHandle (soundHandle: Handle; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
{A channel’s mode can be changed to any other mode valid for a sampled sound (see the Sound}
{Manager chapter of Inside Mac VI). The new mode becomes effective when the channel is idle;}
{it does not affect a currently active channel.}
procedure SetAsyncSoundChannelMode (mode: Longint; whichChannel: Integer);
{Return true if the specified channel is playing a sound.}
function AsyncSoundChannelActive (whichChannel: Integer): Boolean;
{Stop all sound playback on the specified channel. This stops the current sound, and any sounds}
{which are queued for playback. Notify procs are not called for aborted sounds.}
function AsyncSoundChannelAbort (whichChannel: Integer): OSErr;
{Return the number of a not–busy channel, or zero if all channels are currently playing sounds.}
function FindFreeAsyncSoundChannel: Integer;
{Call this periodically to adjust queues and dispose memory. Notify procs are called at this time.}
procedure AsyncSoundIdle;
implementation
uses
Sound;
type
ASndQEl = record
qLink: QElemPtr;
qType: Integer;
aQPlaying: Boolean;
aQCompletionCode: Integer;
aQSoundHandle: Handle;
aQNotifyProc: ProcPtr;
aQNotifyMsg: Longint;
end;
ASndQElPtr = ^ASndQEl;
SoundArrayElt = record
initMode: Longint;
soundMgrChannel: SndChannelPtr;
completionQueue: QHdr;
end;
SoundArrayHdr = Integer;
SoundArray = record
count: SoundArrayHdr;
channels: array[1..1] of SoundArrayElt;
end;
SoundArrayPtr = ^SoundArray;
SoundArrayHdl = ^SoundArrayPtr;
var
theAsyncChannels: SoundArrayHdl;
function AsyncSoundInit (numberOfChannels: Integer): OSErr;
procedure Check (result: Integer);
begin
AsyncSoundInit := result;
if result <> noErr then
begin
theAsyncChannels := nil;
Exit(AsyncSoundInit);
end;
end;
var
environs: SysEnvRec;
i: Integer;
begin
Check(SysEnvirons(1, environs));
if environs.systemVersion < $0607 then {we don’t have the new sound manager}
Check(-1);
if (numberOfChannels <= 0) or (numberOfChannels > AsyncSoundMaxChannels) then
Check(paramErr);
theAsyncChannels := SoundArrayHdl(NewHandleClear(SIZEOF(SoundArrayHdr) + SIZEOF(SoundArrayElt) * numberOfChannels));
if theAsyncChannels <> nil then
with theAsyncChannels^^ do
begin
count := numberOfChannels;
for i := 1 to count do
{$PUSH}
{$R-}
channels[i].initMode := initMono;
{$POP}
end;
Check(MemError);
end;
procedure AsyncSoundClose;
var
whichChannel: Integer;
myErr: OSErr;
begin
if theAsyncChannels <> nil then
begin
for whichChannel := 1 to theAsyncChannels^^.count do
myErr := AsyncSoundChannelAbort(whichChannel);
DisposHandle(Handle(theAsyncChannels));
theAsyncChannels := nil;
end;
end;
function FindFreeAsyncSoundChannel: Integer;
var
whichChannel: Integer;
begin
AsyncSoundIdle;
FindFreeAsyncSoundChannel := 0;
if theAsyncChannels <> nil then
with theAsyncChannels^^ do
for whichChannel := 1 to count do
{$PUSH}
{$R-}
with channels[whichChannel], completionQueue do
{$POP}
if qHead = nil then
begin
FindFreeAsyncSoundChannel := whichChannel;
Leave;
end;
end;
const
kResourceSoundComplete = 1;
kHandleSoundComplete = 2;
{$PUSH}
{$D-}
{$V-}
{$R-}
procedure PlayAsyncCallback (chan: SndChannelPtr; cmd: SndCommand);
begin
case cmd.param1 of
kResourceSoundComplete, kHandleSoundComplete:
ASndQElPtr(cmd.param2)^.aQPlaying := False;
otherwise
;
end;
end;
{$POP}
procedure DoNotifyJSR (msg: Longint; proc: ProcPtr);
inline
$205F, {movea.l (sp)+,a0}
$4E90; {jsr (a0)}
procedure PopQueue (whichChannel: Integer);
var
poppedQElem: Ptr;
myErr: OSErr;
begin
{$PUSH}
{$R-}
with theAsyncChannels^^.channels[whichChannel], completionQueue do
{$POP}
begin
poppedQElem := Ptr(qHead);
myErr := Dequeue(qHead, @completionQueue);
DisposePtr(poppedQElem);
end;
end;
procedure AsyncSoundIdle;
var
whichChannel: Integer;
firstQElt: aSndQElPtr;
myErr: OSErr;
begin
if theAsyncChannels <> nil then
begin
HLock(Handle(theAsyncChannels));
with theAsyncChannels^^ do
for whichChannel := 1 to count do
{$PUSH}
{$R-}
with channels[whichChannel] do
{$POP}
begin
if completionQueue.qHead <> nil then
repeat
firstQElt := aSndQElPtr(completionQueue.qHead);
with firstQElt^ do
if not aQPlaying then
begin
if aQCompletionCode = kResourceSoundComplete then
DisposHandle(aQSoundHandle);
if aQNotifyProc <> nil then
DoNotifyJSR(aQNotifyMsg, aQNotifyProc);
PopQueue(whichChannel);
end;
until (completionQueue.qHead = nil) | firstQElt^.aQPlaying;
if completionQueue.qHead = nil then
begin
myErr := SndDisposeChannel(soundMgrChannel, True);
soundMgrChannel := nil;
end;
end;
HUnlock(Handle(theAsyncChannels));
end;
end;
function ChannelNumberOK (whichChannel: Integer): Boolean;
begin
ChannelNumberOK := (whichChannel > 0) and (whichChannel <= theAsyncChannels^^.count);
end;
function AsyncSoundChannelAbort (whichChannel: Integer): OSErr;
begin
if theAsyncChannels <> nil then
begin
if ChannelNumberOK(whichChannel) then
begin
HLock(Handle(theAsyncChannels));
{$PUSH}
{$R-}
with theAsyncChannels^^.channels[whichChannel] do
{$POP}
begin
AsyncSoundChannelAbort := SndDisposeChannel(soundMgrChannel, True);
while completionQueue.qHead <> nil do
PopQueue(whichChannel);
end;
HUnlock(Handle(theAsyncChannels));
end
else
AsyncSoundChannelAbort := paramErr;
end
else
AsyncSoundChannelAbort := noErr;
end;
function PlayAsyncSound (soundHandle: Handle; whichChannel: Integer; completionCode: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
var
mySndChan: SndChannelPtr;
procedure Check (result: OSErr);
var
err: OSErr;
begin
PlayAsyncSound := result;
if result <> noErr then
begin
if mySndChan <> nil then
err := SndDisposeChannel(mySndChan, True);
Exit(PlayAsyncSound);
end;
end;
const
noSynth = 0;
var
mySndCmd: SndCommand;
begin {PlayAsyncSound}
if not ChannelNumberOK(whichChannel) then
Check(paramErr);
{$PUSH}
{$R-}
with theAsyncChannels^^.channels[whichChannel] do
{$POP}
if completionQueue.qHead = nil then
begin
mySndChan := nil;
Check(SndNewChannel(mySndChan, noSynth, initMode, @PlayAsyncCallback));
end
else
mySndChan := soundMgrChannel;
Check(SndPlay(mySndChan, soundHandle, True));
with mySndCmd do
begin
cmd := callBackCmd;
param1 := completionCode;
param2 := Longint(NewPtr(SIZEOF(ASndQEl)));
with ASndQElPtr(param2)^ do
begin
aQPlaying := True;
aQCompletionCode := completionCode;
aQSoundHandle := soundHandle;
aQNotifyProc := notifyProc;
aQNotifyMsg := notifyMsg;
end;
{$PUSH}
{$R-}
with theAsyncChannels^^.channels[whichChannel] do
{$POP}
begin
soundMgrChannel := mySndChan;
Enqueue(QElemPtr(param2), @completionQueue);
end;
end;
Check(SndDoCommand(mySndChan, mySndCmd, False));
end;
function PlayResource (soundHandle: Handle; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: Longint): OSErr;
var
err: OSErr;
begin
DetachResource(soundHandle);
HNoPurge(soundHandle);
err := PlayAsyncSound(soundHandle, whichChannel, kResourceSoundComplete, notifyProc, notifyMsg);
if err <> noErr then
DisposeHandle(soundHandle);
PlayResource := err;
end;
function PlayAsyncNamedSoundResource (soundName: Str255; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
var
soundHandle: Handle;
begin
if theAsyncChannels <> nil then
begin
soundHandle := GetNamedResource('snd ', soundName);
if soundHandle <> nil then
PlayAsyncNamedSoundResource := PlayResource(soundHandle, whichChannel, notifyProc, notifyMsg)
else
PlayAsyncNamedSoundResource := ResError;
end
else
begin
if notifyProc <> nil then
DoNotifyJSR(notifyMsg, notifyProc);
PlayAsyncNamedSoundResource := noErr;
end;
end;
function PlayAsyncSoundResource (soundID: Integer; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
var
soundHandle: Handle;
begin
if theAsyncChannels <> nil then
begin
soundHandle := GetResource('snd ', soundID);
if soundHandle <> nil then
PlayAsyncSoundResource := PlayResource(soundHandle, whichChannel, notifyProc, notifyMsg)
else
PlayAsyncSoundResource := ResError;
end
else
begin
if notifyProc <> nil then
DoNotifyJSR(notifyMsg, notifyProc);
PlayAsyncSoundResource := noErr;
end;
end;
function PlayAsyncSoundHandle (soundHandle: Handle; whichChannel: Integer; notifyProc: ProcPtr; notifyMsg: univ Longint): OSErr;
begin
if theAsyncChannels <> nil then
PlayAsyncSoundHandle := PlayAsyncSound(soundHandle, whichChannel, kHandleSoundComplete, notifyProc, notifyMsg)
else
begin
if notifyProc <> nil then
DoNotifyJSR(notifyMsg, notifyProc);
PlayAsyncSoundHandle := noErr;
end;
end;
procedure SetAsyncSoundChannelMode (mode: Longint; whichChannel: Integer);
begin
if theAsyncChannels <> nil then
if ChannelNumberOK(whichChannel) then
{$PUSH}
{$R-}
theAsyncChannels^^.channels[whichChannel].initMode := mode;
{$POP}
end;
function AsyncSoundChannelActive (whichChannel: Integer): Boolean;
begin
AsyncSoundIdle;
if theAsyncChannels <> nil then
begin
if ChannelNumberOK(whichChannel) then
{$PUSH}
{$R-}
AsyncSoundChannelActive := theAsyncChannels^^.channels[whichChannel].completionQueue.qHead <> nil;
{$POP}
end
else
AsyncSoundChannelActive := False;
end;
end.